home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 7 / Amiga Format AFCD07 (Dec 1996, Issue 91).iso / serious / shareware / programming / emacs-complete / fsf / emacs / lisp / tempo.el < prev    next >
Lisp/Scheme  |  1994-05-08  |  19KB  |  537 lines
  1. ;;; tempo.el --- templates with hotspots
  2. ;; Copyright (C) 1994 Free Software Foundation, Inc.
  3.  
  4. ;; Author: David K}gedal <davidk@lysator.liu.se >
  5. ;; Created: 16 Feb 1994
  6. ;; Version: 1.1.1
  7. ;; Keywords: extensions, languages, tools
  8.  
  9. ;; This file is part of GNU Emacs.
  10.  
  11. ;; GNU Emacs is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; GNU Emacs is distributed in the hope that it will be useful,
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. ;; GNU General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  23. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24.  
  25. ;;; Commentary:
  26.  
  27. ;; This file provides a simple way to define powerful templates, or
  28. ;; macros, if you wish. It is mainly intended for, but not limited to,
  29. ;; other programmers to be used for creating shortcuts for editing
  30. ;; certain kind of documents. It was originally written to be used by
  31. ;; a HTML editing mode written by Nelson Minar <nelson@reed.edu>, and
  32. ;; his html-helper-mode.el is probably the best example of how to use
  33. ;; this program.
  34.  
  35. ;; A template is defined as a list of items to be inserted in the
  36. ;; current buffer at point. Some of the items can be simple strings,
  37. ;; while other can control formatting or define special points of
  38. ;; interest in the inserted text.
  39.  
  40. ;; If a template defines a "point of interest" that point is inserted
  41. ;; in a buffer-local list of "points of interest" that the user can
  42. ;; jump between with the commands `tempo-backward-mark' and
  43. ;; `tempo-forward-mark'. If the template definer provides a prompt for
  44. ;; the point, and the variable `tempo-interactive' is non-nil, the
  45. ;; user will be prompted for a string to be inserted in the buffer,
  46. ;; using the minibuffer.
  47.  
  48. ;; The template can also define one point to be replaced with the
  49. ;; current region if the template command is called with a prefix (or
  50. ;; a non-nil argument).
  51.  
  52. ;; More flexible templates can be created by including lisp symbols,
  53. ;; which will be evaluated as variables, or lists, which will will be
  54. ;; evaluated as lisp expressions.
  55.  
  56. ;; See the documentation for tempo-define-template for the different
  57. ;; items that can be used to define a tempo template.
  58.  
  59. ;; One of the more powerful features of tempo templates are automatic
  60. ;; completion. With every template can be assigned a special tag that
  61. ;; should be recognized by `tempo-complete-tag' and expanded to the
  62. ;; complete template. By default the tags are added to a global list
  63. ;; of template tags, and are matched against the last word before
  64. ;; point. But if you assign your tags to a specific list, you can also
  65. ;; specify another method for matching text in the buffer against the
  66. ;; tags. In the HTML mode, for instance, the tags are matched against
  67. ;; the text between the last `<' and point.
  68.  
  69. ;; When defining a template named `foo', a symbol named
  70. ;; `tempo-template-foo' will be created whose value as a variable will
  71. ;; be the template definition, and its function value will be an
  72. ;; interactive function that inserts the template at the point.
  73.  
  74. ;; Full documentation for tempo.el can be found on the World Wide Web
  75. ;; at http://www.lysator.liu.se:7500/~davidk/tempo.html (not yet
  76. ;; completed)
  77.  
  78. ;; The latest tempo.el distribution can be fetched from
  79. ;; ftp.lysator.liu.se in the directory /pub/emacs
  80.  
  81. ;;; Code:
  82.  
  83. (provide 'tempo)
  84.  
  85. ;;; Variables
  86.  
  87. (defvar tempo-interactive nil
  88.   "*Prompt user for strings in templates.
  89. If this variable is non-nil, `tempo-insert' prompts the
  90. user for text to insert in the templates")
  91.  
  92. (defvar tempo-insert-region nil
  93.   "*Automatically insert current region when there is a `r' in the template
  94. If this variable is NIL, `r' elements will be treated just like `p'
  95. elements, unless the template function is given a prefix (or a non-nil
  96. argument). If this variable is non-NIL, the behaviour is reversed.")
  97.  
  98. (defvar tempo-show-completion-buffer t
  99.   "*If non-NIL, show a buffer with possible completions, when only
  100. a partial completion can be found")
  101.  
  102. (defvar tempo-leave-completion-buffer nil
  103.   "*If NIL, a completion buffer generated by \\[tempo-complete-tag]
  104. disappears at the next keypress; otherwise, it remains forever.")
  105.  
  106. (defvar tempo-insert-string-functions nil
  107.   "List of functions to run when inserting a string.
  108. Each function is called with a single arg, STRING."  )
  109.  
  110. (defvar tempo-tags nil
  111.   "An association list with tags and corresponding templates")
  112.  
  113. (defvar tempo-local-tags '((tempo-tags . nil))
  114.   "A list of locally installed tag completion lists.
  115.  
  116. It is a association list where the car of every element is a symbol
  117. whose varable value is a template list. The cdr part, if non-nil, is a
  118. function or a regexp that defines the string to match. See the
  119. documentation for the function `tempo-complete-tag' for more info.
  120.  
  121. `tempo-tags' is always in the last position in this list.")
  122.  
  123. (defvar tempo-marks nil
  124.   "A list of marks to jump to with `\\[tempo-forward-mark]' and `\\[tempo-backward-mark]'.")
  125.  
  126. (defvar tempo-default-match-finder "\\b\\([^\\b]*\\)\\="
  127.   "The default regexp used to find the string to match against the tags.")
  128.  
  129. (defvar tempo-named-insertions nil
  130.   "Temporary storage for named insertions")
  131.  
  132. ;; Make some variables local to every buffer
  133.  
  134. (make-variable-buffer-local 'tempo-marks)
  135. (make-variable-buffer-local 'tempo-local-tags)
  136.  
  137. ;;; Functions
  138.  
  139. ;;
  140. ;; tempo-define-template
  141.  
  142. (defun tempo-define-template (name elements &optional tag documentation taglist)
  143.   "Define a template.
  144. This function creates a template variable `tempo-template-NAME' and an
  145. interactive function `tempo-template-NAME' that inserts the template
  146. at the point.  The created function is returned.
  147.  
  148. NAME is a string that contains the name of the template, ELEMENTS is a
  149. list of elements in the template, TAG is the tag used for completion,
  150. DOCUMENTATION is the documentation string for the insertion command
  151. created, and TAGLIST (a symbol) is the tag list that TAG (if provided)
  152. should be added to).  If TAGLIST is nil and TAG is non-nil, TAG is
  153. added to `tempo-tags'
  154.  
  155. The elements in ELEMENTS can be of several types:
  156.  
  157.  - A string. It is sent to the hooks in `tempo-insert-string-functions',
  158.    and the result is inserted.
  159.  - The symbol 'p. This position is saved in `tempo-marks'.
  160.  - The symbol 'r. If `tempo-insert' is called with ON-REGION non-nil
  161.    the current region is placed here. Otherwise it works like 'p.
  162.  - (p PROMPT <NAME>) If `tempo-interactive' is non-nil, the user is
  163.    prompted in the minbuffer with PROMPT for a string to be inserted.
  164.    If the optional parameter NAME is non-nil, the text is saved for
  165.    later insertion with the `s' tag.
  166.    If `tempo-interactive is nil, it works like 'p.
  167.  - (r PROMPT) like the previous, but if `tempo-interactive' is nil
  168.    and `tempo-insert' is called with ON-REGION non-nil, the current
  169.    region is placed here.
  170.  - (s NAME) Inserts text previously read with the (p ..) construct.
  171.    Finds the insertion saved under NAME and inserts it. Acts like 'p
  172.    if tempo-interactive is nil.
  173.  - '& If there is only whitespace between the line start and point,
  174.    nothing happens. Otherwise a newline is inserted.
  175.  - '% If there is only whitespace between point and end-of-line
  176.    nothing happens. Otherwise a newline is inserted.
  177.  - 'n inserts a newline.
  178.  - '> The line is indented using `indent-according-to-mode'. Note that
  179.    you often should place this item after the text you want on the
  180.    line.
  181.  - 'n> inserts a newline and indents line.
  182.  - nil. It is ignored.
  183.  - Anything else. It is evaluated and the result is parsed again."
  184.  
  185.   (let* ((template-name (intern (concat "tempo-template-"
  186.                        name)))
  187.      (command-name template-name))
  188.     (set template-name elements)
  189.     (fset command-name (list 'lambda (list '&optional 'arg)
  190.                  (or documentation 
  191.                  (concat "Insert a " name "."))
  192.                  (list 'interactive "*P")
  193.                  (list 'tempo-insert-template (list 'quote
  194.                                 template-name)
  195.                    (list 'if 'tempo-insert-region
  196.                      (list 'not 'arg) 'arg))))
  197.     (and tag
  198.      (tempo-add-tag tag template-name taglist))
  199.     command-name))
  200.  
  201. ;;;
  202. ;;; tempo-insert-template
  203.  
  204. (defun tempo-insert-template (template on-region)
  205.   "Insert a template.
  206. TEMPLATE is the template to be inserted.  If ON-REGION is non-nil the
  207. `r' elements are replaced with the current region."
  208.   (and on-region
  209.        (< (mark) (point))
  210.        (exchange-point-and-mark))
  211.   (save-excursion
  212.     (tempo-insert-mark (point-marker))
  213.     (mapcar 'tempo-insert 
  214.         (symbol-value template))
  215.     (tempo-insert-mark (point-marker)))
  216.   (tempo-forward-mark)
  217.   (tempo-forget-insertions))
  218.  
  219. ;;;
  220. ;;; tempo-insert
  221.  
  222. (defun tempo-insert (element) 
  223.   "Insert a template element.
  224. Insert one element from a template. See documentation for
  225. `tempo-define-template' for the kind of elements possible."
  226.   (cond ((stringp element) (tempo-process-and-insert-string element))
  227.     ((and (consp element) (eq (car element) 'p))
  228.      (tempo-insert-prompt (cdr element)))
  229.     ((and (consp element) (eq (car element) 'r))
  230.      (if on-region
  231.          (exchange-point-and-mark)
  232.        (tempo-insert-prompt (cdr element))))
  233.     ((and (consp element) (eq (car element) 's))
  234.      (if tempo-interactive
  235.          (tempo-insert-named (cdr element))
  236.        (tempo-insert-mark (point-marker))))
  237.     ((eq element 'p) (tempo-insert-mark (point-marker)))
  238.     ((eq element 'r) (if on-region
  239.                  (exchange-point-and-mark)
  240.                (tempo-insert-mark (point-marker))))
  241.     ((eq element '>) (indent-according-to-mode))
  242.     ((eq element '&) (if (not (or (= (current-column) 0)
  243.                       (save-excursion
  244.                     (re-search-backward
  245.                      "^\\s-*\\=" nil t))))
  246.                  (insert "\n")))
  247.     ((eq element '%) (if (not (or (eolp)
  248.                       (save-excursion
  249.                     (re-search-forward
  250.                      "\\=\\s-*$" nil t))))
  251.                  (insert "\n")))
  252.     ((eq element 'n) (insert "\n"))
  253.     ((eq element 'n>) (insert "\n") (indent-according-to-mode))
  254.     ((null element))
  255.     (t (tempo-insert (eval element)))))
  256.  
  257. ;;;
  258. ;;; tempo-insert-prompt
  259.  
  260. (defun tempo-insert-prompt (prompt)
  261.   "Prompt for a text string and insert it in the current buffer.
  262. If the variable `tempo-interactive' is non-nil the user is prompted
  263. for a string in the minibuffer, which is then inserted in the current
  264. buffer. If `tempo-interactive' is nil, the current point is placed on
  265. `tempo-mark'.
  266.  
  267. PROMPT is the prompt string or a list containing the prompt string and
  268. a name to save the inserted text under."
  269.   (if tempo-interactive
  270.       (let ((prompt-string (if (listp prompt)
  271.                    (car prompt)
  272.                  prompt))
  273.         (save-name (and (listp prompt) (nth 1 prompt)))
  274.         inserted-text)
  275.  
  276.     (progn
  277.       (setq inserted-text (read-string prompt-string))
  278.       (insert inserted-text)
  279.       (if save-name
  280.           (tempo-remember-insertion save-name inserted-text))))
  281.     (tempo-insert-mark (point-marker))))
  282.  
  283. ;;;
  284. ;;; tempo-remember-insertion
  285.  
  286. (defun tempo-remember-insertion (save-name string)
  287.   "Save the text in STRING under the name SAVE-NAME for later retrieval."
  288.   (setq tempo-named-insertions (cons (cons save-name string)
  289.                      tempo-named-insertions)))
  290.  
  291. ;;;
  292. ;;; tempo-forget-insertions
  293.  
  294. (defun tempo-forget-insertions ()
  295.   "Forget all the saved named insertions."
  296.   (setq tempo-named-insertions nil))
  297.  
  298. ;;;
  299. ;;; tempo-insert-named
  300.  
  301. (defun tempo-insert-named (elt)
  302.   "Insert the previous insertion saved under a named specified in ELT.
  303. The name is in the car of ELT."
  304.   (let* ((name (car elt))
  305.      (insertion (cdr (assq name tempo-named-insertions))))
  306.     (if insertion
  307.     (insert insertion)
  308.       (error "Named insertion not found"))))
  309.  
  310. ;;;
  311. ;;; tempo-process-and-insert-string
  312.  
  313. (defun tempo-process-and-insert-string (string)
  314.   "Insert a string from a template.
  315. Run a string through the preprocessors in `tempo-insert-string-functions'
  316. and insert the results."
  317.   (cond ((null tempo-insert-string-functions)
  318.      nil)
  319.     ((symbolp tempo-insert-string-functions)
  320.      (setq string
  321.            (apply tempo-insert-string-functions (list string))))
  322.     ((listp tempo-insert-string-functions)
  323.      (mapcar (function (lambda (fn)
  324.                  (setq string (apply fn string))))
  325.          tempo-insert-string-functions))
  326.     (t
  327.      (error "Bogus value in tempo-insert-string-functions: %s"
  328.         tempo-insert-string-functions)))
  329.   (insert string))
  330.  
  331. ;;;
  332. ;;; tempo-insert-mark
  333.  
  334. (defun tempo-insert-mark (mark)
  335.   "Insert a mark `tempo-marks' while keeping it sorted"
  336.   (cond ((null tempo-marks) (setq tempo-marks (list mark)))
  337.     ((< mark (car tempo-marks)) (setq tempo-marks (cons mark tempo-marks)))
  338.     (t (let ((lp tempo-marks))
  339.          (while (and (cdr lp)
  340.              (<= (car (cdr lp)) mark))
  341.            (setq lp (cdr lp)))
  342.          (if (not (= mark (car lp)))
  343.          (setcdr lp (cons mark (cdr lp))))))))
  344.       
  345. ;;;
  346. ;;; tempo-forward-mark
  347.  
  348. (defun tempo-forward-mark ()
  349.   "Jump to the next mark in `tempo-forward-mark-list'."
  350.   (interactive)
  351.   (let ((next-mark (catch 'found
  352.              (mapcar
  353.               (function
  354.                (lambda (mark)
  355.              (if (< (point) mark)
  356.                  (throw 'found mark))))
  357.               tempo-marks)
  358.              ;; return nil if not found
  359.              nil)))
  360.     (if next-mark
  361.     (goto-char next-mark))))
  362.  
  363. ;;;
  364. ;;; tempo-backward-mark
  365.  
  366. (defun tempo-backward-mark ()
  367.   "Jump to the previous mark in `tempo-back-mark-list'."
  368.   (interactive)
  369.   (let ((prev-mark (catch 'found
  370.              (let (last)
  371.                (mapcar
  372.             (function
  373.              (lambda (mark)
  374.                (if (<= (point) mark)
  375.                    (throw 'found last))
  376.                (setq last mark)))
  377.             tempo-marks)
  378.                last))))
  379.     (if prev-mark
  380.     (goto-char prev-mark))))
  381.     
  382. ;;;
  383. ;;; tempo-add-tag
  384.  
  385. (defun tempo-add-tag (tag template &optional tag-list)
  386.   "Add a template tag.
  387.  
  388. Add the TAG, that should complete to TEMPLATE to the list in TAG-LIST,
  389. or to `tempo-tags' if TAG-LIST is nil."
  390.  
  391.   (interactive "sTag: \nCTemplate: ")
  392.   (if (null tag-list)
  393.       (setq tag-list 'tempo-tags))
  394.   (if (not (assoc tag (symbol-value tag-list)))
  395.       (set tag-list (cons (cons tag template) (symbol-value tag-list)))))
  396.  
  397. ;;;
  398. ;;; tempo-use-tag-list
  399.  
  400. (defun tempo-use-tag-list (tag-list &optional completion-function)
  401.   "Install TAG-LIST to be used for template completion in the current buffer.
  402.  
  403. TAG-LIST is a symbol whose variable value is a tag list created with
  404. `tempo-add-tag' and COMPLETION-FUNCTION is an optional function or
  405. string that is used by `\\[tempo-complete-tag]' to find a string to
  406. match the tag against.
  407.  
  408. If COMPLETION-FUNCTION is a string, it should contain a regular
  409. expression with at least one \\( \\) pair. When searching for tags,
  410. `tempo-complete-tag' calls `re-search-backward' with this string, and
  411. the string between the first \\( and \\) is used for matching against
  412. each string in the tag list. If one is found, the whole text between
  413. the first \\( and the point is replaced with the inserted template.
  414.  
  415. You will probably want to include \\ \= at the end of the regexp to make
  416. sure that the string is matched only against text adjacent to the
  417. point.
  418.  
  419. If COPMLETION-FUNCTION is a symbol, it should be a function that
  420. returns a cons cell of the form (STRING . POS), where STRING is the
  421. string used for matching and POS is the buffer position after which
  422. text should be replaced with a template."
  423.  
  424.   (let ((old (assq tag-list tempo-local-tags)))
  425.     (if old
  426.     (setcdr old completion-function)
  427.       (setq tempo-local-tags (cons (cons tag-list completion-function)
  428.                    tempo-local-tags)))))
  429.  
  430. ;;;
  431. ;;; tempo-find-match-string
  432.  
  433. (defun tempo-find-match-string (finder)
  434.   "Find a string to be matched against a tag list.
  435.  
  436. FINDER is a function or a string. Returns (STRING . POS)."
  437.   (cond ((stringp finder)
  438.      (save-excursion
  439.        (re-search-backward finder nil t))
  440.      (cons (buffer-substring (match-beginning 1) (1+ (match-end 1)))
  441.            (match-beginning 1)))
  442.     (t
  443.      (funcall finder))))
  444.  
  445. ;;;
  446. ;;; tempo-complete-tag
  447.  
  448. (defun tempo-complete-tag (&optional silent)
  449.   "Look for a tag and expand it.
  450.  
  451. It goes through the tag lists in `tempo-local-tags' (this includes
  452. `tempo-tags') and for each list it uses the corresponding match-finder
  453. function, or `tempo-default-match-finder' if none is given, and tries
  454. to match the match string against the tags in the list using
  455. `try-completion'. If none is found it proceeds to the next list until
  456. one is found. If a partial completion is found, it is replaced by the
  457. template if it can be completed uniquely, or completed as far as
  458. possible.
  459.  
  460. When doing partial completion, only tags in the currently examined
  461. list are considered, so if you provide similar tags in different lists
  462. in `tempo-local-tags', the result may not be desirable.
  463.  
  464. If no match is found or a partial match is found, and SILENT is
  465. non-nil, the function will give a signal.
  466.  
  467. If tempo-show-completion-buffer is non-NIL, a buffer containing
  468. possible completions is displayed when a partial completion is found."
  469.  
  470.   ;; This function is really messy. Some cleaning up is necessary.
  471.   (interactive)
  472.   (if (catch 'completed
  473.     (mapcar
  474.      (function
  475.       (lambda (tag-list-a)
  476.         (let* ((tag-list (symbol-value(car tag-list-a)))
  477.            (match-string-finder (or (cdr tag-list-a)
  478.                         tempo-default-match-finder))
  479.            (match-info (tempo-find-match-string match-string-finder))
  480.            (match-string (car match-info))
  481.            (match-start (cdr match-info))
  482.            (compl (or (cdr (assoc match-string tag-list))
  483.                   (try-completion match-string
  484.                           tag-list))))
  485.     
  486.           (if compl            ;any match
  487.           (delete-region match-start (point)))
  488.  
  489.           (cond
  490.            ((null compl)        ; No match
  491.         nil)
  492.            ((symbolp compl)        ; ??
  493.         (tempo-insert-template compl nil)
  494.         (throw 'completed t))
  495.            ((eq compl t)        ; Exact, sole match
  496.         (tempo-insert-template (cdr (assoc match-string tag-list))
  497.                        nil)
  498.         (throw 'completed t))
  499.            ((stringp compl)        ; (partial) completion found
  500.         (let ((compl2 (assoc compl tag-list)))
  501.           (if compl2
  502.               (tempo-insert-template (cdr compl2) nil)
  503.             (insert compl)
  504.             (if t ;(string= match-string compl)
  505.             (if tempo-show-completion-buffer
  506.                 (tempo-display-completions match-string
  507.                                tag-list)
  508.               (if (not silent)
  509.                   (ding))))))
  510.         (throw 'completed t))))))
  511.      tempo-local-tags)
  512.     ;; No completion found. Return nil
  513.     nil)
  514.       ;; Do nothing if a completion was found
  515.       t
  516.     ;; No completion was found
  517.     (if (not silent)
  518.     (ding))
  519.     nil))
  520.  
  521. ;;;
  522. ;;; tempo-display-completions
  523.  
  524. (defun tempo-display-completions (string tag-list)
  525.   "Show a buffer containing possible completions for STRING."
  526.   (if tempo-leave-completion-buffer
  527.       (with-output-to-temp-buffer "*Completions*"
  528.     (display-completion-list
  529.      (all-completions string tag-list)))
  530.     (save-window-excursion
  531.       (with-output-to-temp-buffer "*Completions*"
  532.     (display-completion-list
  533.      (all-completions string tag-list)))
  534.       (sit-for 32767))))
  535.  
  536. ;;; tempo.el ends here
  537.